home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Commodities / Activity / activity.e.bak < prev    next >
Text File  |  1996-09-26  |  18KB  |  648 lines
  1. -> activity.e - commodity to monitor user activity
  2.  
  3. OPT PREPROCESS
  4.  
  5. MODULE 'icon',
  6.        'commodities',
  7.        'amigalib/argarray',
  8.        'other/ecode',
  9.        'devices/inputevent',
  10.        'dos/dos',
  11.        'exec/libraries',
  12.        'exec/ports',
  13.        'libraries/commodities',
  14.        'intuition/intuition',
  15.        'utility/tagitem',
  16.        'gadtools',
  17.        'libraries/gadtools',
  18.        'tools/ctype',
  19.        'workbench/workbench',
  20.        'workbench/startup',
  21.        'exec/tasks',
  22.        'exec/nodes',
  23.        'dos/dosextens',
  24.        'dos/datetime',
  25.        'exec/io',
  26.        'devices/timer',
  27.        'dos/dostags'
  28.  
  29. ENUM ERR_NONE, ERR_ARGS, ERR_BRKR, ERR_CRCX, ERR_CXERR, ERR_ECODE, ERR_LIB,
  30.      ERR_PORT, ERR_SIG, ERR_MENU, ERR_IO, ERR_DEV
  31.  
  32. ENUM FIELD_DATE,FIELD_TIME,FIELD_LEFT,FIELD_RIGHT,FIELD_MOVE,FIELD_KEY
  33.  
  34. CONST EVT_POPUP=1,EVT_QUIT=2
  35.  
  36. RAISE ERR_BRKR IF CxBroker()=NIL,
  37.       ERR_CRCX IF CreateCxObj()=NIL,
  38.       ERR_LIB  IF OpenLibrary()=NIL,
  39.       ERR_PORT IF CreateMsgPort()=NIL,
  40.       ERR_SIG  IF AllocSignal()=-1,
  41.       ERR_MENU IF LayoutMenusA()=NIL,
  42.       ERR_IO   IF CreateIORequest()=NIL,
  43.       ERR_DEV  IF OpenDevice()<>0
  44.  
  45. DEF broker_mp=NIL:PTR TO mp, broker=NIL, cocustom=NIL, cosignal=NIL,
  46.     task, cxsigflag, signal=-1, cxobjsignal, wnd=NIL:PTR TO window,
  47.     title[30]:STRING,hotkey:PTR TO CHAR,quitkey:PTR TO CHAR,
  48.     menus=NIL,tformat:PTR TO CHAR,
  49.     topedge,leftedge,savetime,file:PTR TO CHAR,timerMP=NIL:PTR TO mp,
  50.     timerIO=NIL:PTR TO timerequest,timersigflag=0,width
  51.  
  52. DEF left=0,right=0,move=0,key=0
  53.  
  54. -> main()
  55. PROC main() HANDLE
  56.   DEF ttypes=NIL, msg, cxfunc
  57.   DEF x,filter
  58.   DEF vis=NIL
  59.   DEF openerr=1
  60.   DEF nb_err
  61.   cxbase:=OpenLibrary('commodities.library', 37)
  62.   -> Open the icon.library for support functions, argXXX()
  63.   iconbase:=OpenLibrary('icon.library', 36)
  64.   ttypes:=argArrayInit()
  65.  
  66.   gadtoolsbase:=OpenLibrary('gadtools.library',36)
  67.   vis:=GetVisualInfoA(OpenWorkBench(),[NIL])
  68.   IF vis=NIL THEN Raise(ERR_MENU)
  69.   menus:=CreateMenusA(
  70.     [ 1,0,'Project',0,0,0,0,
  71.        2,0,'About','A',0,0,0,
  72.        2,0,'Help','?',0,0,0,
  73.        2,0,-1,0,0,0,0,
  74.        2,0,'Save','S',0,0,0,
  75.        2,0,'Reset','R',0,0,0,
  76.        2,0,-1,0,0,0,0,
  77.        2,0,'Hide','H',0,0,0,
  78.        2,0,'Quit','Q',0,0,0,
  79.       1,0,'Extras',0,0,0,0,
  80.        2,0,'AStats','T',IF argString(ttypes,'FILE',NIL) AND (FileLength('PROGDIR:AStats')>0) THEN 0 ELSE NM_ITEMDISABLED,0,0,
  81.      0,0,NIL,0,0,0,0]:newmenu,
  82.      [NIL])
  83.   IF menus=NIL THEN Raise(ERR_MENU)
  84.   LayoutMenusA(menus,vis,[GTMN_NEWLOOKMENUS,TRUE,NIL])
  85.  
  86.   broker_mp:=CreateMsgPort()
  87.   cxsigflag:=Shl(1, broker_mp.sigbit)
  88.  
  89.  
  90.   broker:=CxBroker([NB_VERSION, 0, 'Activity',
  91.                     'Activity-meter', 'Monitor user activity',
  92.                     NBU_UNIQUE OR NBU_NOTIFY, COF_SHOW_HIDE,
  93.                     argInt(ttypes, 'CX_PRIORITY', 0),
  94.                     0, broker_mp, 0]:newbroker,{nb_err})
  95.  
  96.   IF NIL=(cxfunc:=eCodeCxCustom({cxFunction})) THEN Raise(ERR_ECODE)
  97.   cocustom:=CxCustom(cxfunc, 0)
  98.   AttachCxObj(broker, cocustom)
  99.   signal:=AllocSignal(-1)
  100.   cxobjsignal:=Shl(1, signal)
  101.   cxsigflag:=cxsigflag OR cxobjsignal
  102.   task:=FindTask(NIL)
  103.   cosignal:=CxSignal(task, signal)
  104.   AttachCxObj(cocustom, cosignal)
  105.  
  106.   quitkey:=argString(ttypes, 'QUITKEY', 'control lcommand m')
  107.   filter:=CxFilter(quitkey)
  108.   IF CxObjError(filter) THEN Throw(ERR_CXERR,'QUITKEY not OK')
  109.   AttachCxObj(broker, filter)
  110.   x:=CxSender(broker_mp, EVT_QUIT)
  111.   AttachCxObj(filter, x)
  112.   x:=CxTranslate(NIL)
  113.   AttachCxObj(filter, x)
  114.  
  115.   hotkey:=argString(ttypes, 'CX_POPKEY', 'control alt m')
  116.   filter:=CxFilter(hotkey)
  117.   IF CxObjError(filter) THEN Throw(ERR_CXERR,'CX_POPKEY not OK')
  118.   AttachCxObj(broker, filter)
  119.   x:=CxSender(broker_mp, EVT_POPUP)
  120.   AttachCxObj(filter, x)
  121.   x:=CxTranslate(NIL)
  122.   AttachCxObj(filter, x)
  123.  
  124.   tformat:=argString(ttypes,'FORMAT','L:%L R:%R K:%K')
  125.   leftedge:=argInt(ttypes,'X',0)
  126.   topedge:=argInt(ttypes,'Y',0)
  127.   width:=argInt(ttypes,'WIDTH',300)
  128.  
  129.   savetime:=argInt(ttypes,'SAVETIME',0)
  130.   IF savetime<0
  131.     IF EasyRequestArgs(0,[20,0,'Activity Warning','Negative savetime.','Savetime:=\d|Auto-save off']:easystruct,0,[-savetime])
  132.       savetime:=-savetime
  133.     ELSE
  134.       savetime:=0
  135.     ENDIF
  136.   ENDIF
  137.   file:=argString(ttypes,'FILE',NIL)
  138.   IF file=NIL THEN savetime:=0
  139.   loadc()
  140.  
  141.   IF savetime
  142.     timerMP:=CreateMsgPort()
  143.     timersigflag:=Shl(1,timerMP.sigbit)
  144.     timerIO:=CreateIORequest(timerMP,SIZEOF timerequest)
  145.     openerr:=OpenDevice('timer.device',UNIT_VBLANK,timerIO,0)
  146.     inittimer()
  147.   ENDIF
  148.  
  149.   ActivateCxObj(broker, TRUE)
  150.   IF CxObjError(filter) THEN Throw(ERR_CXERR,'Broker error')
  151.   IF argBool(ttypes,'CX_POPUP',TRUE) THEN appear()
  152.   processMsg()
  153.  
  154. EXCEPT DO
  155.   disappear()
  156.   IF savetime
  157.     IF openerr=0
  158.       AbortIO(timerIO)
  159.       WaitIO(timerIO)
  160.       CloseDevice(timerIO)
  161.     ENDIF
  162.     IF timerIO THEN DeleteIORequest(timerIO)
  163.     IF timerMP THEN DeleteMsgPort(timerMP)
  164.   ENDIF
  165.   IF signal<>-1 THEN FreeSignal(signal)
  166.   IF broker THEN DeleteCxObjAll(broker)
  167.   IF broker_mp
  168.     -> Empty the port of all CxMsgs
  169.     WHILE msg:=GetMsg(broker_mp) DO ReplyMsg(msg)
  170.     DeleteMsgPort(broker_mp)
  171.   ENDIF
  172.   IF menus THEN FreeMenus(menus)
  173.   IF vis THEN FreeVisualInfo(vis)
  174.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  175.   IF ttypes THEN argArrayDone()
  176.   IF iconbase THEN CloseLibrary(iconbase)
  177.   IF cxbase THEN CloseLibrary(cxbase)
  178.   SELECT exception
  179.   CASE ERR_ARGS;  WriteF('Error: Could not parse tooltypes/arguments\n')
  180.   CASE ERR_BRKR;  IF nb_err<>CBERR_DUP THEN WriteF('Error: Could not create broker\n')
  181.   CASE ERR_CRCX;  WriteF('Error: Could not create CX object\n')
  182.   CASE ERR_CXERR; WriteF('Error: CxObj - \s\n',exceptioninfo)
  183.   CASE ERR_ECODE; WriteF('Error: Ran out of memory in eCodeCxCustom()\n')
  184.   CASE ERR_LIB;   WriteF('Error: Could not open commodities.library\n')
  185.   CASE ERR_PORT;  WriteF('Error: Could not create message port\n')
  186.   CASE ERR_SIG;   WriteF('Error: Could not allocate signal\n')
  187.   CASE ERR_MENU;  WriteF('Error: Could not create/layout menus\n')
  188.   CASE ERR_IO;    WriteF('Error: Could not create IO request\n')
  189.   CASE ERR_DEV;   WriteF('Error: Could not open timer.device\n')
  190.   ENDSELECT
  191. ENDPROC
  192.  
  193. -> inittimer() - send IORequest for timer
  194. PROC inittimer()
  195.   timerIO.io.command:=TR_ADDREQUEST
  196.   timerIO.time.secs:=savetime
  197.   timerIO.time.micro:=0
  198.   SendIO(timerIO)
  199. ENDPROC
  200.  
  201. -> processMsg() - process messages
  202. PROC processMsg()
  203.   DEF msg:PTR TO intuimessage, sigrcvd, msgid, msgtype, done=FALSE, class, code
  204.   DEF menunumber,item:PTR TO menuitem,command
  205.   REPEAT
  206.     IF wnd=NIL
  207.       sigrcvd:=Wait(SIGBREAKF_CTRL_C OR cxsigflag OR timersigflag)
  208.     ELSE
  209.       sigrcvd:=Wait(SIGBREAKF_CTRL_C OR cxsigflag OR timersigflag OR Shl(1,wnd.userport.sigbit))
  210.       WHILE msg:=GetMsg(wnd.userport)
  211.         class:=msg.class
  212.         code:=msg.code
  213.         ReplyMsg(msg)
  214.         SELECT class
  215.           CASE IDCMP_CLOSEWINDOW
  216.             disappear()
  217.           CASE IDCMP_VANILLAKEY
  218.             SELECT code
  219.               CASE 27
  220.                 disappear()
  221.               CASE "Q"
  222.                 disappear()
  223.               CASE "q"
  224.                 disappear()
  225.               CASE "x"
  226.                 done:=TRUE
  227.               CASE "X"
  228.                 done:=TRUE
  229.               CASE "h"
  230.                 disappear()
  231.               CASE "H"
  232.                 disappear()
  233.               CASE "a"
  234.                 about()
  235.               CASE "A"
  236.                 about()
  237.               CASE "r"
  238.                 left:=0;right:=0;move:=0;key:=0
  239.                 formattitle(tformat,title)
  240.                 SetWindowTitles(wnd,title,-1)
  241.                 savec()
  242.               CASE "R"
  243.                 left:=0;right:=0;move:=0;key:=0
  244.                 formattitle(tformat,title)
  245.                 SetWindowTitles(wnd,title,-1)
  246.                 savec()
  247.               CASE "s"
  248.                 savec()
  249.                 saves()
  250.               CASE "S"
  251.                 savec()
  252.                 saves()
  253.             ENDSELECT
  254.           CASE IDCMP_RAWKEY
  255.             SELECT code
  256.               CASE 95
  257.                 help()
  258.             ENDSELECT
  259.           CASE IDCMP_MENUPICK
  260.             menunumber:=code AND $FFFF
  261.             WHILE (menunumber<>MENUNULL)
  262.               item:=ItemAddress(menus,menunumber)
  263.               command:=item.command
  264.               SELECT command
  265.                 CASE "A"
  266.                   about()
  267.                 CASE "?"
  268.                   help()
  269.                 CASE "S"
  270.                   saves()
  271.                   savec()
  272.                 CASE "R"
  273.                   left:=0;right:=0;move:=0;key:=0
  274.                   formattitle(tformat,title)
  275.                   SetWindowTitles(wnd,title,-1)
  276.                   savec()
  277.                 CASE "H"
  278.                   disappear()
  279.                 CASE "Q"
  280.                   done:=TRUE
  281.                 CASE "T"
  282.                   run_astats()
  283.               ENDSELECT
  284.               menunumber:=item.nextselect AND $FFFF
  285.               EXIT done
  286.               EXIT wnd=NIL
  287.             ENDWHILE
  288.         ENDSELECT
  289.         EXIT wnd=NIL
  290.       ENDWHILE
  291.     ENDIF
  292.  
  293.     WHILE msg:=GetMsg(broker_mp)
  294.       msgid:=CxMsgID(msg)
  295.       msgtype:=CxMsgType(msg)
  296.       ReplyMsg(msg)
  297.  
  298.       SELECT msgtype
  299.         CASE CXM_COMMAND
  300.           SELECT msgid
  301.             CASE CXCMD_DISABLE
  302.               ActivateCxObj(broker, FALSE)
  303.             CASE CXCMD_ENABLE
  304.               ActivateCxObj(broker, TRUE)
  305.             CASE CXCMD_APPEAR
  306.               appear()
  307.             CASE CXCMD_DISAPPEAR
  308.               disappear()
  309.             CASE CXCMD_KILL
  310.               done:=TRUE
  311.             CASE CXCMD_UNIQUE
  312.               appear()
  313.           ENDSELECT
  314.         CASE CXM_IEVENT
  315.           SELECT msgid
  316.             CASE EVT_POPUP; appear()
  317.             CASE EVT_QUIT;  savec(); done:=TRUE
  318.           ENDSELECT
  319.       ENDSELECT
  320.     ENDWHILE
  321.  
  322.     IF sigrcvd AND SIGBREAKF_CTRL_C THEN done:=TRUE
  323.  
  324.     -> Check to see if the signal CxObj signalled us.
  325.     IF sigrcvd AND cxobjsignal
  326.       formattitle(tformat,title)
  327.       IF wnd
  328.         SetWindowTitles(wnd,title,-1)
  329.       ENDIF
  330.     ENDIF
  331.  
  332.     IF timersigflag
  333.       IF GetMsg(timerMP)
  334.         inittimer()
  335.         savec()
  336.       ENDIF
  337.     ENDIF
  338.   UNTIL done
  339.   disappear()
  340. ENDPROC
  341.  
  342. -> appear() - show interface
  343. PROC appear()
  344.   IF wnd=NIL
  345.     wnd:=OpenWindowTagList(NIL,
  346.     [WA_TITLE,title,WA_SCREENTITLE,'Activity by Jilles Tjoelker',
  347.      WA_WIDTH,width,WA_HEIGHT,11,WA_LEFT,leftedge,WA_TOP,topedge,
  348.      WA_CLOSEGADGET,TRUE,WA_DEPTHGADGET,TRUE,WA_DRAGBAR,TRUE,
  349.      WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_VANILLAKEY OR IDCMP_RAWKEY OR IDCMP_MENUPICK,
  350.      WA_ACTIVATE,TRUE,WA_NEWLOOKMENUS,TRUE,
  351.      TAG_DONE])
  352.      SetMenuStrip(wnd,menus)
  353.   ELSE
  354.     WindowToFront(wnd)
  355.     ActivateWindow(wnd)
  356.   ENDIF
  357.   ScreenToFront(wnd.wscreen)
  358.   formattitle(tformat,title)
  359.   SetWindowTitles(wnd,title,-1)
  360. ENDPROC
  361.  
  362. -> disappear() - hide interface
  363. PROC disappear()
  364.   IF wnd
  365.     topedge:=wnd.topedge
  366.     leftedge:=wnd.leftedge
  367.     ClearMenuStrip(wnd)
  368.     CloseWindow(wnd)
  369.     wnd:=NIL
  370.   ENDIF
  371. ENDPROC
  372.  
  373. -> cxFunction() - function for CxCustom object
  374. PROC cxFunction(cxm, co)
  375.   DEF ie:PTR TO inputevent
  376.  
  377.   ie:=CxMsgData(cxm)
  378.  
  379.   IF ie.class=IECLASS_RAWMOUSE
  380.     IF ie.code=IECODE_LBUTTON
  381.       left++
  382.       IF wnd THEN DivertCxMsg(cxm, co, co)
  383.     ELSEIF ie.code=IECODE_RBUTTON
  384.       right++
  385.       IF wnd THEN DivertCxMsg(cxm, co, co)
  386.     ELSEIF ie.code=IECODE_NOBUTTON
  387.       move++
  388. ->      IF (move AND $FF=0) AND wnd THEN DivertCxMsg(cxm, co, co)
  389.     ENDIF
  390.   ELSEIF ie.class=IECLASS_RAWKEY
  391.     IF ie.code<=95
  392.       key++
  393.       IF wnd THEN DivertCxMsg(cxm, co, co)
  394.     ENDIF
  395.   ENDIF
  396. ENDPROC
  397.  
  398. -> vers() - version string
  399. PROC vers() IS '$VER: Activity 2.1 (07-Mar-1996)'
  400.  
  401. -> about() - show about requester
  402. PROC about()
  403.   EasyRequestArgs(wnd,
  404.     [20,0,'About Activity',
  405.     'Activity by Jilles Tjoelker\n\nE-mail: M.Tjoelker@mpn.cp.philips.com\n\nSnailmail:\nJ. Tjoelker\nCraterlaan 6\n5632 AG Eindhoven\nTHE NETHERLANDS\n\nHotkey: \s\n\s',
  406.     'OK']:easystruct,
  407.     0,[hotkey,vers()])
  408. ENDPROC
  409.  
  410. -> help() - display help requester
  411. PROC help()
  412.   EasyRequestArgs(wnd,
  413.     [20,0,'Activity help',
  414.     'Function: Monitors user activity.\n\nL: Left mouse button \nR: Right mouse button\nK: Keyboard \n\nKeys:\nESC, Q, H - Hide window\nX         - Exit activity\nR         - Reset counters\nA         - About this program\nS         - Save counters & window position\nHELP      - This requester\n\n\s - Popup\n\s - Save & quit',
  415.     'OK']:easystruct,
  416.     0,[hotkey,quitkey])
  417. ENDPROC
  418.  
  419. -> run_astats() - start AStats program
  420. PROC run_astats()
  421.   DEF in,cmd[256]:STRING,cd
  422.   IF file
  423.     cd:=CurrentDir(GetProgramDir())
  424.     StringF(cmd,'AStats \s',file)
  425.     IF in:=Open('CON:////AStats Output/AUTO/WAIT',MODE_OLDFILE)
  426.       IF SystemTagList(cmd,[SYS_ASYNCH,TRUE,SYS_INPUT,in,SYS_OUTPUT,0,0])=-1
  427.         Close(in)
  428.       ENDIF
  429.     ENDIF
  430.     CurrentDir(cd)
  431.   ELSE
  432.     DisplayBeep(NIL)
  433.   ENDIF
  434. ENDPROC
  435.  
  436. -> argBool() - this argXxx() function is missing
  437. PROC argBool(ttypes,name,val)
  438.   DEF s:PTR TO CHAR
  439.   s:=argString(ttypes,name,NIL)
  440.   IF s
  441.     val:=TRUE
  442.     IF (s[0]="n") OR (s[0]="N")
  443.       val:=FALSE
  444.     ENDIF
  445.   ENDIF
  446. ENDPROC val
  447.  
  448. -> formattitle() - create the title string
  449. PROC formattitle(fmt:PTR TO CHAR,dest:PTR TO CHAR)
  450.   DEF i,temp[20]:STRING,pct=FALSE,x
  451.   dest[]:=0
  452.   FOR i:=0 TO StrLen(fmt)-1
  453.     IF pct
  454.       x:=toupper(fmt[i])
  455.       SELECT x            -> SELECT only with variable. GRRR!
  456.         CASE "L"
  457.           StringF(temp,'\d',left)
  458.           AstrCopy(dest,temp,256)
  459.           dest:=dest+StrLen(dest)
  460.         CASE "R"
  461.           StringF(temp,'\d',right)
  462.           AstrCopy(dest,temp,256)
  463.           dest:=dest+StrLen(dest)
  464.         CASE "M"
  465.           StringF(temp,'\d',move)
  466.           AstrCopy(dest,temp,256)
  467.           dest:=dest+StrLen(dest)
  468.         CASE "K"
  469.           StringF(temp,'\d',key)
  470.           AstrCopy(dest,temp,256)
  471.           dest:=dest+StrLen(dest)
  472.         DEFAULT
  473.           dest[]:=fmt[i]
  474.           dest++
  475.       ENDSELECT
  476.       pct:=FALSE
  477.     ELSE
  478.       IF fmt[i]="%"
  479.         pct:=TRUE
  480.       ELSE
  481.         dest[]:=fmt[i]
  482.         dest++
  483.       ENDIF
  484.     ENDIF
  485.   ENDFOR
  486. ENDPROC
  487.  
  488. -> saves() - save settings (X and Y)
  489. PROC saves() HANDLE
  490.   DEF do=NIL:PTR TO diskobject
  491.   DEF tt=NIL:PTR TO LONG,size=0,i=0
  492.   DEF p:PTR TO LONG,temp[20]:STRING,j=0
  493.   DEF xd=0,yd=0 -> X done, Y done
  494.   DEF wbm:PTR TO wbstartup,cd
  495.   DEF do_tt=NIL
  496.   p:=[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]  -> Memory allocations
  497.  
  498.   IF wbmessage
  499.     wbm:=wbmessage
  500.     cd:=CurrentDir(wbm.arglist[0].lock)
  501.     IF do:=GetDiskObject(wbm.arglist[0].name)
  502.       do_tt:=do.tooltypes
  503.       IF do.tooltypes
  504.         WHILE do.tooltypes[size] DO size++
  505.       ELSE
  506.         size:=0
  507.       ENDIF
  508.       tt:=NewR(size+8*4)
  509.       FOR i:=0 TO size+7 DO tt[i]:=NIL
  510.       CopyMem(do.tooltypes,tt,size+1*4)
  511.       FOR i:=0 TO size+6
  512.         IF ((toupper(tt[i][0])="X") AND (tt[i][1]="=")) OR ((xd=0) AND (tt[i]=0))
  513.           tt[i]:=NewR(20)
  514.           p[j]:=tt[i]
  515.           j++
  516.           StringF(temp,'X=\d',IF wnd THEN wnd.leftedge ELSE leftedge)
  517.           AstrCopy(tt[i],temp)
  518.           xd:=-1
  519.         ENDIF
  520.         IF ((toupper(tt[i][0])="Y") AND (tt[i][1]="=")) OR ((yd=0) AND (tt[i]=0))
  521.           tt[i]:=NewR(20)
  522.           p[j]:=tt[i]
  523.           j++
  524.           StringF(temp,'Y=\d',IF wnd THEN wnd.topedge ELSE topedge)
  525.           AstrCopy(tt[i],temp)
  526.           yd:=-1
  527.         ENDIF
  528.       ENDFOR
  529.       do.tooltypes:=tt
  530.       PutDiskObject(wbm.arglist[0].name,do)
  531.       CurrentDir(cd)
  532.     ENDIF
  533.   ELSE
  534. ->    EasyRequestArgs(wnd,[20,0,'Activity Error','Can\at save when started from CLI.','OK']:easystruct,0,NIL)
  535.   ENDIF
  536. EXCEPT DO
  537.   FOR i:=0 TO j
  538.     IF p[i] THEN Dispose(p[i])
  539.   ENDFOR
  540.   IF tt THEN Dispose(tt)
  541.   IF do
  542.     do.tooltypes:=do_tt
  543.     FreeDiskObject(do)
  544.   ENDIF
  545. ENDPROC
  546.  
  547. -> savec() - save counters
  548. PROC savec()
  549.   DEF lock=0,fh=0
  550.   IF file
  551.     tryagain:
  552.     IF lock:=Lock(file,EXCLUSIVE_LOCK)
  553.       IF fh:=OpenFromLock(lock)
  554.         Seek(fh,0,OFFSET_END)
  555.         writec(fh)
  556.         Close(fh)
  557.       ELSE
  558.         UnLock(lock)
  559.       ENDIF
  560.     ELSE
  561.       IF IoErr()=ERROR_OBJECT_NOT_FOUND
  562.         IF fh:=Open(file,MODE_NEWFILE)
  563.           Fputs(fh,'Activity save file\n')
  564.           Fputs(fh,'Do not modify!\n\n')
  565.           Fputs(fh,'DATE       TIME       LEFT     RIGHT    MOVE     KEYS    \n')
  566.           Fputs(fh,'---------- ---------- -------- -------- -------- --------\n')
  567.           writec(fh)
  568.           Close(fh)
  569.         ELSE
  570.           IF EasyRequestArgs(0,[20,0,'Activity Error','Couldn\at create counters file.','Retry|Cancel']:easystruct,0,NIL)
  571.             JUMP tryagain
  572.           ENDIF
  573.         ENDIF
  574.       ELSE
  575.         IF EasyRequestArgs(0,[20,0,'Activity Error','Couldn\at save counters.','Retry|Cancel']:easystruct,0,NIL)
  576.           JUMP tryagain
  577.         ENDIF
  578.       ENDIF
  579.     ENDIF
  580.   ENDIF
  581. ENDPROC
  582.  
  583. -> writec() - write a record to filehandle fh
  584. PROC writec(fh)
  585.   DEF dt:datetime,date[16]:ARRAY,time[16]:ARRAY
  586.   DateStamp(dt)
  587.   dt.format:=FORMAT_CDN
  588.   dt.flags:=0
  589.   dt.strday:=NIL
  590.   dt.strdate:=date
  591.   dt.strtime:=time
  592.   DateToStr(dt)
  593.   VfPrintf(fh,'\l\s[10];\s[10];\d[8];\d[8];\d[8];\d[8]\r\n',[date,time,left,right,move,key])
  594. ENDPROC
  595.  
  596. /* FILE FORMAT, EXPECTED BY loadc()
  597.   * The first lines are ignored. Reading starts after the line which starts
  598.     with "--".
  599.   * Fields, semicolon ";" between them.
  600.     1. FIELD_DATE \_ Not used
  601.     2. FIELD_TIME /  by loadc()
  602.     3. FIELD_LEFT \
  603.     4. FIELD_RIGHT \_ Counters
  604.     5. FIELD_MOVE  /
  605.     6. FIELD_KEY  /
  606.   * Lines should not be longer than 79 characters.
  607. */
  608.  
  609. -> loadc() - load counters
  610. PROC loadc()
  611.   DEF fh,string[82]:ARRAY,str[80]:ARRAY,rd=FALSE,
  612.     fnr,tmp
  613.   string[0]:=";"
  614.   IF file
  615.     IF fh:=Open(file,MODE_OLDFILE)
  616.       WHILE Fgets(fh,str,80)
  617.         IF rd
  618.           AstrCopy(string+1,str,81)
  619.           fnr:=0
  620.           tmp:=-1
  621.           WHILE (tmp:=InStr(string,';',tmp+1))<>-1
  622.             SELECT fnr
  623.               CASE FIELD_LEFT
  624.                 left:=Val(str+tmp)
  625.               CASE FIELD_RIGHT
  626.                 right:=Val(str+tmp)
  627.               CASE FIELD_MOVE
  628.                 move:=Val(str+tmp)
  629.               CASE FIELD_KEY
  630.                 key:=Val(str+tmp)
  631.             ENDSELECT
  632.             fnr++
  633.           ENDWHILE
  634.         ELSE
  635.           IF (str[0]="-") AND (str[1]="-") THEN rd:=TRUE
  636.         ENDIF
  637.       ENDWHILE
  638.       Close(fh)
  639.     ELSE
  640.       IF IoErr()=ERROR_OBJECT_NOT_FOUND THEN savec() -> create a new file
  641.     ENDIF
  642.   ENDIF
  643. ENDPROC
  644. /*EE folds
  645. -1
  646. 55 135 59 4 63 137 67 16 71 7 75 21 82 5 86 5 90 13 94 8 98 36 102 55 106 32 110 9 127 32 
  647. EE folds*/
  648.